Overview

This document contains code for creating and recreating Petra’s visualizaitons for the report.

To Do:

  • put in the number of people in each of the groups
  • change colors in plot to match Petra’s plots
  • figure out if I need to site the protocol

Depiction of Large Continuous Dataset

# Get and order patient 2 data
pt2_data <- ds_cgm_complete %>%
  select(pt_id, 
         visit,
         visitnum, 
         device_visit_period_day, 
         device_tm,
         device_tm_bin, 
         glucose_value) %>%
  filter(pt_id == 2) %>%
  arrange(visitnum, device_visit_period_day, device_tm_bin) %>%
  group_by(visit) %>%
  mutate(time_order = 1:n())

One patient, one day

animate1 <- pt2_data %>%
  filter(visitnum == 1, device_visit_period_day == 1) %>%
  ggplot(aes(x = device_tm, 
             y = glucose_value, 
             color = visitnum)) + 
  geom_point(aes(group = seq_along(device_tm)), size = 0.5) +
  #scale_color_brewer(palette = "Paired") +
  labs(x = "Time of Day", y = "Glucose Value (mg/dL)",
       title = "Data for One Participant") +
  theme(legend.position = "none",
        text = element_text(size = 16)) + 
  transition_reveal(device_tm)
anim_save(animate1, filename = "../figures/try/animate1.png")

One patient, eight days (one visit period)

pt2_data %>%
  filter(visitnum == 1) %>%
  ggplot(aes(x = device_tm, 
             y = glucose_value, 
             color = as.factor(device_visit_period_day),
             group = as.factor(device_visit_period_day))) + 
  geom_point(aes(group = seq_along(device_tm)), size = 0.5) +
  scale_color_brewer(palette = "Paired") +
  labs(x = "Time of Day", y = "Glucose Value (mg/dL)") +
  theme(legend.position = "none") +
  transition_reveal(time_order)

pt2_data %>%
  filter(visitnum == 1) %>%
  ggplot(aes(x = device_tm, 
             y = glucose_value, 
             color = as.factor(visitnum),
             group = as.factor(device_visit_period_day))) + 
  geom_point(aes(group = seq_along(device_tm)), size = 0.5) +
  labs(x = "Time of Day", y = "Glucose Value (mg/dL)") +
  theme(legend.position = "none") +
  scale_color_brewer(palette = "Paired") +
  facet_wrap(device_visit_period_day ~ ., nrow = 2) +
  transition_reveal(time_order)

One patient, all days and visits

pt2_data %>%
  ggplot(aes(x = device_tm, 
             y = glucose_value, 
             color = as.factor(visit),
             group = as.factor(device_visit_period_day))) + 
  geom_point(aes(group = seq_along(device_tm)), size = 0.5) +
  labs(x = "Time of Day", y = "Glucose Value (mg/dL)",
       title = "Data from One Participant") +
  theme(legend.position = "none",
        text = element_text(size = 16)) + 
  facet_wrap(visit ~ ., nrow = 2) +
  scale_color_brewer(palette = "Paired") +
  transition_reveal(time_order)

Study Design

Timeline

# Creates event data
study_events <- data.frame(week_num = c(-10, 0, 0, 3, 6, 13, 19, 26),
                           week_buffer = c(-10.05, 0, 0, 3, 6, 13, 19, 26.05),
                           week_name = c("Enrollment", 
                                         "Week 0",
                                         "Week 0",
                                         "Week 3", 
                                         "Week 6", 
                                         "Week 13", 
                                         "Week 19", 
                                         "Week 26"),
                           event = c("Screening Visit", 
                                     NA, 
                                     "Randomization 2:1 (Visit 0)", 
                                     "Visit 1", 
                                     "Visit 2",
                                     "Visit 3", 
                                     "Visit 4", 
                                     "Visit 5"), 
                           period = factor(c(rep("Run-In Phase", 2), 
                                      rep("Main Study", 6)), 
                                      levels = c("Run-In Phase", 
                                                 "Main Study")),
                           week_ypos = rep(0, 8), 
                           event_ypos = c(0.2, 0.3, 0.3, 0.2, 
                                          0.2, 0.2, 0.2, 0.2))

# Plots the events on a time line
study_timeline <- study_events %>%
  ggplot(mapping = aes(x = week_num, 
                       y = week_ypos, 
                       color = period, 
                       group = period,
                       label = event)) + 
  geom_segment(mapping = aes(y = week_ypos,
                             yend = event_ypos,
                             xend = week_num),
               color = 'black',
               size = 0.5) +
  geom_point(aes(x = week_num, 
                 y = event_ypos),
             size = 3) +
  geom_line(size = 6, aes(x = week_buffer)) + 
  geom_text(mapping = aes(x = week_num,
                          y = event_ypos,
                          label = event),
            size = 5,
            color = 'black',
            vjust = -1) +
   geom_text(mapping = aes(x = week_num,
                           y = -.02,
                           label = week_name),
            size = 5,
            color = 'black',
            angle = 45,
            vjust = 1.5,
            hjust = 1) +
  xlim(-12, 28) +
  ylim(-0.2, 0.4) +
  labs(color = "Study Period") + 
  theme_void() + 
  theme(legend.position = "bottom",
        legend.title = element_text(size = 14),
        legend.text = element_text(size = 12)) +
  scale_color_brewer(palette = "Paired")

# Print the figure
study_timeline

# Save the figure for the report
ggsave(plot = study_timeline, 
       filename = "../figures/timeline.png", 
       width = 12, 
       height = 3)

# Save the figure for the presentation
ggsave(plot = study_timeline, 
       filename = "../figures/timeline_pres.png", 
       width = 9, 
       height = 3)

All Curves for a Patient

# Plot of glucose values for all days and visits for patient 70
pt_curves <- ds_cgm %>%
  filter(pt_id == 70) %>%
  ggplot(aes(x = device_tm, 
             y = glucose_value,
             group = as.factor(device_dt_tm_days_from_enroll),
             col = as.factor(visit))) +
  facet_wrap(. ~ visit) +
  geom_line(size = 0.25, show.legend = FALSE) +
  theme_bw() +
  geom_hline(yintercept = 70, color = "black", linetype = "dashed") +
  geom_hline(yintercept = 180, color = "black", linetype = "dashed") +
  scale_color_brewer(palette = "Paired") +  
  labs(x = "Time of Day", y = "Glucose Value (mg/dL)")

# Print the figure
pt_curves

# Save the figure
ggsave(plot = pt_curves, 
       filename = "../figures/pt_curves.png", 
       width = 6, 
       height = 4)

Objective

# Create a plot showing summary statistic comparison
summary_stats <- ds_cgm_complete %>%
  filter(visitnum == 5) %>%
  group_by(trt_group, visitnum) %>%
  summarise(mean_glucose = mean(glucose_value),
            sd_glucose = sd(glucose_value)) %>%
  ggplot(aes(x = trt_group, y = mean_glucose)) + 
  geom_errorbar(aes(ymin = mean_glucose - sd_glucose,
                    ymax = mean_glucose + sd_glucose),
                width = 0.2, size = 0.75) + 
  geom_point(aes(color = trt_group), size = 5) +
  scale_color_brewer(palette = "Paired") +
  labs(x = "Treatment Group", y = "Glucose Value",
       title = "Previous: Statistics Comparison") + 
  theme_classic() +
  theme(text = element_text(size = 16),
        legend.position = "none")

# Create a plot showing function comparison
fun_compare <- ds_cgm_complete %>%
  filter(visitnum == 5, pt_id %in% c(2, 8)) %>%
  ggplot(aes(x = device_tm, y = glucose_value, 
             color = trt_group, group = trt_group)) + 
  geom_smooth() + 
  scale_color_brewer(palette = "Paired") +
  labs(x = "Time of Day", y = "Glucose Value", color = "Treatment Group",
       title = "Our Goal: Function Comparison") + 
  theme_classic() + 
  theme(text = element_text(size = 16),
        legend.position = "bottom")

# Extract the legend from the functional comparison plot
obj_legend <- get_legend(fun_compare)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
# Join the objective plots
obj_plots <- plot_grid(summary_stats, fun_compare + theme(legend.position = "none"))
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
# Add the legend
obj_figure <- plot_grid(obj_plots, obj_legend, 
                        nrow = 2, 
                        rel_heights = c(0.9, 0.1))

# Print the figure
obj_figure

# Save the figure
ggsave(plot = obj_figure, 
       filename = "../figures/obj_figure.png", 
       width = 10, 
       height = 5)

Data Structure and Preprocessing

Missing Visit Periods

# Plot the patients who have observations in a visit period
missed_visits <- ds_cgm %>%
  select(pt_id, visitnum) %>%
  distinct() %>%
  ggplot(aes(x = visitnum, y = pt_id, fill = visitnum)) + 
  geom_tile() + 
  scale_fill_brewer(palette = "Paired") + 
  labs(x = "Visit Period",
       y = "Participant", 
       fill = "Visit Period") +
  theme(axis.text.y = element_blank(),
        axis.ticks.y = element_blank())

# Print the figure
missed_visits

# Save the figure
ggsave(plot = missed_visits, 
       filename = "../figures/missed_visits.png", 
       width = 6, 
       height = 4)

Missing Times

# Plot missing times during a day for one patient
missed_times <- ds_cgm_complete %>%
  filter(pt_id == 70, visitnum == 5, device_visit_period_day == 2) %>%
  right_join(data.frame(device_tm_bin = 1:288)) %>%
  ggplot(aes(x = device_tm, y = glucose_value)) + 
  geom_path() + 
  labs(x = "Time of Day", y = "Glucose Value")

# Print the figure
missed_times

# Save the figure
ggsave(plot = missed_times, 
       filename = "../figures/missed_times.png", 
       width = 6, 
       height = 4)

Demographics Table

#Relabel 
var.labels <- c(gender = "Gender",
                ethnicity = "Ethnicity",
                diag_age = "Age at Diagnosis",
                oth_gluc_lower_med = "Other Glucose Lowering Medication",
                edu_level = "Highest Education Level",
                weight = "Weight",
                height = "Height",
                cgm_use_status = "CGM Use",
                pt_status = "Completed Study",
                trt_group = "Treatment Group",
                age_as_of_enroll_dt = "Age at Enrollment"
)
ds_subject <- Hmisc::upData(ds_subject, labels = var.labels) 
## Input object size:    37968 bytes;    13 variables    226 observations
## New object size: 39544 bytes;    13 variables    226 observations
compareGroups(trt_group ~ pt_status + gender + ethnicity + diag_age + age_as_of_enroll_dt +
                edu_level + weight + height + cgm_use_status,
              data = ds_subject %>% 
                filter(pt_id %in% unique(ds_cgm_complete_3days$pt_id)),
              include.miss = TRUE) %>%
  createTable(show.p.overall = TRUE,
              #hide = c("No"),
              show.n = TRUE) %>%
  export2latex(header.labels = c(p.overall = "p-value"))
##     
##     \begin{longtable}{lcccc}\caption{Summary descriptives table by groups of `Treatment Group'}\\
##     \hline  
##      &  CGM Only   &   CGM+BGM   & \multirow{2}{*}{p-value} & \multirow{2}{*}{ N }\\ 
##  &    N=131    &    N=73     &         &     \\ 
##   
##     \hline
##     \hline     
##     \endfirsthead 
##     \multicolumn{5}{l}{\tablename\ \thetable{} \textit{-- continued from previous page}}\\ 
##     \hline
##      &  CGM Only   &   CGM+BGM   & \multirow{2}{*}{p-value} & \multirow{2}{*}{ N }\\ 
##  &    N=131    &    N=73     &         &     \\ 
## 
##     \hline
##     \hline  
##     \endhead   
##     \hline
##     \multicolumn{5}{l}{\textit{continued on next page}} \\ 
##     \endfoot   
##     \multicolumn{5}{l}{}  \\ 
##     \endlastfoot 
##     Completed Study: Completed & 131 (100\%)  &  73 (100\%)  &    .    & 204\\ 
## Gender: &             &             &  0.327  & 204\\ 
## $\qquad$F & 61 (46.6\%)  & 40 (54.8\%)  &         &    \\ 
## $\qquad$M & 70 (53.4\%)  & 33 (45.2\%)  &         &    \\ 
## Ethnicity: &             &             &  0.100  & 204\\ 
## $\qquad$Hispanic or Latino &  2 (1.53\%)  &  5 (6.85\%)  &         &    \\ 
## $\qquad$Not Hispanic or Latino & 128 (97.7\%) & 68 (93.2\%)  &         &    \\ 
## $\qquad$Unknown/not reported &  1 (0.76\%)  &  0 (0.00\%)  &         &    \\ 
## Age at Diagnosis & 20.4 (13.0) & 20.5 (12.6) &  0.960  & 204\\ 
## Age at Enrollment & 44.2 (14.0) & 45.0 (13.2) &  0.714  & 204\\ 
## Highest Education Level: &             &             &  0.554  & 204\\ 
## $\qquad$Associate Degree &  4 (3.05\%)  &  3 (4.11\%)  &         &    \\ 
## $\qquad$Bachelor's Degree & 64 (48.9\%)  & 32 (43.8\%)  &         &    \\ 
## $\qquad$Doctorate Degree &  3 (2.29\%)  &  3 (4.11\%)  &         &    \\ 
## $\qquad$High school graduate/diploma/GED &  4 (3.05\%)  &  2 (2.74\%)  &         &    \\ 
## $\qquad$Master's Degree & 28 (21.4\%)  & 18 (24.7\%)  &         &    \\ 
## $\qquad$Professional Degree &  6 (4.58\%)  &  5 (6.85\%)  &         &    \\ 
## $\qquad$Some college but no degree & 21 (16.0\%)  &  7 (9.59\%)  &         &    \\ 
## $\qquad$'Missing' &  1 (0.76\%)  &  3 (4.11\%)  &         &    \\ 
## Weight & 83.5 (15.4) & 78.1 (15.7) &  0.020  & 204\\ 
## Height & 173 (10.7)  & 172 (10.6)  &  0.655  & 204\\ 
## CGM Use: &             &             &  0.872  & 204\\ 
## $\qquad$Current & 61 (46.6\%)  & 36 (49.3\%)  &         &    \\ 
## $\qquad$In past, but not current & 46 (35.1\%)  & 23 (31.5\%)  &         &    \\ 
## $\qquad$Never & 24 (18.3\%)  & 14 (19.2\%)  &         &     \\ 
##  
##     \hline
##     \end{longtable}

Comparing Treatments

ds_cgm_complete %>%
  group_by(visitnum, trt_group) %>%
  summarise(mean_glucose = mean(glucose_value)) %>%
  ggplot(aes(x = visitnum, y = mean_glucose, 
             color = trt_group, group = trt_group)) + 
  geom_point() + 
  geom_line()

Other

ds_cgm_complete %>%
  filter(pt_id %in% c(2, 3)) %>%
  filter(visitnum == 5) %>%
  select(pt_id, device_dt_tm_days_from_enroll) %>%
  ggplot(aes(x = device_dt_tm_days_from_enroll, y = pt_id)) + 
  geom_point()

Session Info

## R version 3.6.1 (2019-07-05)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS Mojave 10.14.5
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] scales_1.0.0        lubridate_1.7.4     ggrepel_0.8.1      
##  [4] gganimate_1.0.3     forcats_0.4.0       dplyr_0.8.1        
##  [7] cowplot_0.9.4       ggplot2_3.2.0       compareGroups_4.1.0
## [10] SNPassoc_1.9-2      mvtnorm_1.0-10      survival_2.44-1.1  
## [13] haplo.stats_1.7.9  
## 
## loaded via a namespace (and not attached):
##  [1] nlme_3.1-140        rms_5.1-3.1         webshot_0.5.1      
##  [4] RColorBrewer_1.1-2  progress_1.2.2      httr_1.4.0         
##  [7] tools_3.6.1         backports_1.1.4     R6_2.4.0           
## [10] rpart_4.1-15        mgcv_1.8-28         Hmisc_4.2-0        
## [13] lazyeval_0.2.2      colorspace_1.4-1    jomo_2.6-8         
## [16] nnet_7.3-12         withr_2.1.2         prettyunits_1.0.2  
## [19] tidyselect_0.2.5    gridExtra_2.3       compiler_3.6.1     
## [22] chron_2.3-53        rvest_0.3.4         quantreg_5.40      
## [25] htmlTable_1.13.1    HardyWeinberg_1.6.3 mice_3.6.0         
## [28] SparseM_1.77        xml2_1.2.0          sandwich_2.5-1     
## [31] labeling_0.3        checkmate_1.9.3     polspline_1.1.15   
## [34] readr_1.3.1         epitools_0.5-10     stringr_1.4.0      
## [37] digest_0.6.20       foreign_0.8-71      minqa_1.2.4        
## [40] rmarkdown_1.13      base64enc_0.1-3     pkgconfig_2.0.2    
## [43] htmltools_0.3.6     lme4_1.1-21         htmlwidgets_1.3    
## [46] rlang_0.4.0         rstudioapi_0.10     farver_1.1.0       
## [49] generics_0.0.2      zoo_1.8-6           acepack_1.4.1      
## [52] magrittr_1.5        kableExtra_1.1.0    Formula_1.2-3      
## [55] Matrix_1.2-17       Rcpp_1.0.1          munsell_0.5.0      
## [58] stringi_1.4.3       multcomp_1.4-10     yaml_2.2.0         
## [61] MASS_7.3-51.4       plyr_1.8.4          grid_3.6.1         
## [64] mitml_0.3-7         crayon_1.3.4        lattice_0.20-38    
## [67] splines_3.6.1       hms_0.5.0           zeallot_0.1.0      
## [70] knitr_1.23          pillar_1.4.2        boot_1.3-22        
## [73] codetools_0.2-16    pan_1.6             glue_1.3.1         
## [76] evaluate_0.14       latticeExtra_0.6-28 gifski_0.8.6       
## [79] data.table_1.12.2   png_0.1-7           tweenr_1.0.1       
## [82] vctrs_0.2.0         nloptr_1.2.1        MatrixModels_0.4-1 
## [85] gtable_0.3.0        purrr_0.3.2         tidyr_0.8.3        
## [88] assertthat_0.2.1    xfun_0.8            broom_0.5.2        
## [91] Rsolnp_1.16         viridisLite_0.3.0   truncnorm_1.0-8    
## [94] tibble_2.1.3        cluster_2.1.0       writexl_1.1        
## [97] TH.data_1.0-10